home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gsdbloo.exe / GS_STRNG.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-24  |  13KB  |  351 lines
  1. unit GS_Strng;
  2. {-----------------------------------------------------------------------------
  3.                            String Handling Routines
  4.  
  5.        GS_Strng Copyright (c)  Richard F. Griffin
  6.  
  7.         1 January 1991
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the routines for string handling.
  14.  
  15. Changes:
  16.          13 Apr 91 - Added function Strip_Flip.  This function will remove
  17.                      trailing spaces and move any part of the string that
  18.                      is preceeded by a '~' to the end of the string.
  19.                      For Example:
  20.                                  Smith~John X.
  21.                           will be converted to:
  22.                                  John X. Smith
  23.                           on return.
  24.  
  25.                      This is ideal for maintaining a name alphabetically
  26.                      while allowing a simple function to make the name
  27.                      'normal' on display.
  28.  
  29.          02 May 91 - Converted StrDate to accept a longint and convert to the
  30.                      MM/DD/YY string format.  The longint value is the julian
  31.                      date (for example, 1 Jan 90 has a julian date of 2447893)
  32.  
  33.                      Added a ValDate function to convert a date string of
  34.                      either MM/DD/YY or YYYYMMDD to the longint juilian day.
  35.  
  36.          10 Aug 91 - Modified Unique_Field to return a unique field that can
  37.                      also serve as a FileName.  First character is alpha and
  38.                      othere are alpha(uppercase) or numeric.  Previously, the
  39.                      routine returned uppercase, lowercase, and special chars.
  40.  
  41. ------------------------------------------------------------------------------}
  42.  
  43. interface
  44. {$D-}
  45.  
  46. uses
  47.    Crt,
  48.    Dos,
  49.    GS_Date;
  50.  
  51. function AllCaps(var t : string) : string;
  52. procedure CnvAscToStr(var asc, st; lth : integer);
  53. procedure CnvStrToAsc(var st, asc; lth : integer);
  54. function Strip_Flip(st : string) : string;
  55. function StrDate(jul : longint) : string;
  56. function StrNumber(num : real; lth,dec : integer) : string;
  57. function StrLogic(tf : boolean) : string;
  58. function SubStr(s : string; b,l : integer) : string;
  59. function TrimL(strn : string):string; {Deletes leading spaces}
  60. function TrimR(strn : string):string; {Deletes trailing spaces}
  61. function Unique_Field : string;       {Used to create a unique 8-byte string}
  62. function ValDate(strn : string) : longint;
  63. function ValNumber(strn : string) : real;
  64. function ValLogic(strn : string) : boolean;
  65.  
  66.  
  67. implementation
  68.  
  69. function AllCaps(var t : string) : string;
  70. var
  71.    i : integer;
  72.    s : string;
  73. begin
  74.    s := t;
  75.    for i := 1 to length(s) do s[i] := upcase(s[i]);
  76.    AllCaps := s;
  77. end;
  78.  
  79. procedure CnvAscToStr(var asc, st; lth : integer);
  80. var
  81.    a : array[0..255] of byte absolute asc;
  82.    s : string[255] absolute st;
  83.    i : integer;
  84. begin
  85.    move(a,s[1],lth);
  86.    s[0] := chr(lth);
  87.    i := pos(#0,s);
  88.    if i > 0 then dec(i)
  89.       else if a[0] <> 0 then i := lth;
  90.    s[0] := chr(i);
  91. end;
  92.  
  93. procedure CnvStrToAsc(var st, asc; lth : integer);
  94. var
  95.    a : array[0..255] of byte absolute asc;
  96.    s : string[255] absolute st;
  97.    t : string;
  98.    i : integer;
  99. begin
  100.    t := s;
  101.    FillChar(a,lth,#0);
  102.    i := length(t);
  103.    if i >= lth then i := lth;
  104.    move(t[1],a,i);
  105. end;
  106.  
  107. Function Strip_Flip(st : string) : string;
  108. var
  109.    wst,
  110.    wstl : string;
  111.    i    : integer;
  112. begin
  113.    wst := TrimR(st);
  114.    wst := wst + ' ';
  115.    i := pos('~', wst);
  116.    if i <> 0 then
  117.    begin
  118.       wstl := substr(wst,1,pred(i));
  119.       system.delete(wst,1,i);
  120.       wst := wst + wstl;
  121.    end;
  122.    Strip_Flip := wst;
  123. end;
  124.  
  125. function StrDate(jul : longint) : string;
  126. begin
  127.    StrDate := GS_Date_View(jul);
  128. end;
  129.  
  130. function StrNumber(num : real; lth,dec : integer) : string;
  131. var
  132.    s : string;
  133. begin
  134.    Str(num:lth:dec,s);
  135.    StrNumber := s;
  136. end;
  137.  
  138. function StrLogic(tf : boolean) : string;
  139. begin
  140.    if tf then StrLogic := 'T' else StrLogic := 'F';
  141. end;
  142.  
  143. {.pa}
  144. {
  145.  
  146.                                    SUBSTR
  147.  
  148.      ╔══════════════════════════════════════════════════════════════════╗
  149.      ║                                                                  ║
  150.      ║   The SUBSTR function extracts a substring from a string.        ║
  151.      ║                                                                  ║
  152.      ║       Calling the Method:                                        ║
  153.      ║                                                                  ║
  154.      ║               x := SubStr(s,b,l)                                 ║
  155.      ║                                                                  ║
  156.      ║               ( where x is the string to be trimmed.             ║
  157.      ║                       s is of type string.                       ║
  158.      ║                       b is the integer start of substring.       ║
  159.      ║                       l is the integer length of substring.      ║
  160.      ║                                                                  ║
  161.      ║                                                                  ║
  162.      ║       Result:                                                    ║
  163.      ║                                                                  ║
  164.      ║           A substring of l positions beginning at b is returned. ║
  165.      ║                                                                  ║
  166.      ╚══════════════════════════════════════════════════════════════════╝
  167. }
  168.  
  169.  
  170. Function SubStr(s : string; b,l : integer) : string;
  171. var
  172.    st : string;
  173.    i  : integer;
  174. begin
  175.    st := '';
  176.    if b < 0 then b := 1;
  177.    st := copy(s, b, l);
  178.    SubStr := st;
  179. end;
  180. {.pa}
  181. {
  182.  
  183.                                     TRIML
  184.  
  185.      ╔══════════════════════════════════════════════════════════════════╗
  186.      ║                                                                  ║
  187.      ║   The TRIML function removes leading spaces from a field.        ║
  188.      ║                                                                  ║
  189.      ║       Calling the Method:                                        ║
  190.      ║                                                                  ║
  191.      ║                d := TrimL(x)                                     ║
  192.      ║                                                                  ║
  193.      ║               ( where x is the string to be trimmed.             ║
  194.      ║                       d is of type string.                       ║
  195.      ║                                                                  ║
  196.      ║       Result:                                                    ║
  197.      ║                                                                  ║
  198.      ║           Leading spaces are removed and the field returned.     ║
  199.      ║                                                                  ║
  200.      ╚══════════════════════════════════════════════════════════════════╝
  201. }
  202.  
  203.  
  204. function TrimL(strn : string) : string;
  205. var
  206.    st : string;
  207. begin
  208.    st := strn;                        {Load work string}
  209.    while (length(st) > 0) and (st[1] = ' ') do delete(st, 1, 1);
  210.                                       {Loop to delete leading spaces}
  211.    TrimL := st;                       {Return trimmed string}
  212. end;
  213. {.pa}
  214. {
  215.  
  216.                                     TRIMR
  217.  
  218.      ╔══════════════════════════════════════════════════════════════════╗
  219.      ║                                                                  ║
  220.      ║   The TRIMR function removes trailing spaces from a field.       ║
  221.      ║                                                                  ║
  222.      ║       Calling the Method:                                        ║
  223.      ║                                                                  ║
  224.      ║                d := TrimR(x)                                     ║
  225.      ║                                                                  ║
  226.      ║               ( where x is the string to be trimmed.             ║
  227.      ║                       d is of type s